home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / LOGINOUT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-14  |  13.5 KB  |  467 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  8-28-88 5:02 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit Loginout;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Dos, Globals, TPSTRING, TPDOS,
  19.   TAccess, Core1, Core2, Utilmnu2;
  20.   
  21.   
  22. procedure login;
  23.  
  24. procedure wrapup;
  25.  
  26. procedure check_300_restrict;
  27.  
  28.  
  29.   {==========================================================================}
  30.   
  31.   
  32. Implementation
  33.  
  34.  
  35.   procedure login;
  36.   
  37.   var
  38.     continue,
  39.     abort           : Boolean;
  40.     key             : StrName;
  41.     
  42.     
  43.     procedure get_new_user(var continue : Boolean);
  44.     
  45.     var
  46.       i               : Integer;
  47.       
  48.     begin
  49.       continue := False;
  50.       WriteLn(Com);
  51.       WriteLn(Com, 'Name not found.');
  52.       list('A');
  53.       WriteLn(Com);
  54.       continue := ask('Are you a new user', 'N');
  55.       if continue then
  56.         with user_rec do
  57.           begin
  58.             cy := '';
  59.             ph := '';
  60.             FillChar(last_read, 128, 0);
  61.             get_nulls;
  62.             repeat
  63.               st := prompt('From what STATE [2 letter abbrev.] are you calling', len_st, 'ES')
  64.             until (Length(st) = 2) or (not Online);
  65.             repeat
  66.               cy := prompt('What CITY', len_ad, 'ESL')
  67.             until (Length(cy) > 1) or (not Online);
  68.             for i := 2 to Length(cy) do
  69.               if (cy[i] in ['A'..'Z']) then
  70.                 if cy[Pred(i)] <> Chr($20) then
  71.                   cy[i] := Chr(Ord(cy[i])+32);
  72.             get_phone;
  73.             repeat
  74.               ad := prompt('What type of computer do you use ', len_ad, 'ESL');
  75.             until (Length(ad) > 1) or (not online);
  76.             get_case;
  77.             WriteLn(Com);
  78.             WriteLn(Com, '  Name: ', fn, ' ', ln);
  79.             WriteLn(Com, ' Phone: ', ph);
  80.             WriteLn(Com, '  City: ', cy, ', ', st, '.');
  81.             WriteLn(Com, 'System: ', ad);
  82.             WriteLn(Com);
  83.             continue := online and (ask('Is this correct', 'Y'));
  84.             if continue then
  85.               begin
  86.                 get_new_password;
  87.                 get_protocol;
  88.                 pause;
  89.                 WriteLn(Com);
  90.                 continue := online;
  91.                 used := 0;
  92.                 if fn = 'SYSOP' then
  93.                   access := 255
  94.                 else
  95.                   access := uval_acc;
  96.                 limit := uval_time;
  97.                 if fn = 'SYSOP' then
  98.                   conf_flags := 254
  99.                 else
  100.                   conf_flags := 0;
  101.                 columns := def_chars;
  102.                 lines := def_lines;
  103.                 for i := 0 to 5 do
  104.                   laston[i] := 0;
  105.                 time_today := 0;
  106.                 Flags := 0;
  107.                 if (not down_ok) then
  108.                   set_bit(Flags, 1);
  109.                 time_total := 0;
  110.                 lasthi := 0;
  111.                 if CreditType = Files then
  112.                   upload := 0
  113.                 else
  114.                   upload := UpCredit;
  115.                 download := 0;
  116.                 acct_bal := 0;
  117.                 caca := 0;
  118.                 ratio := up_down_ratio;
  119.                 key := pad(ln, len_ln)+pad(fn, len_fn);
  120.                 if continue then
  121.                   begin
  122.                     AddRec(DatF, user_loc, user_rec);
  123.                     AddKey(IdxF, user_loc, key);
  124.                     FlushFile(DatF);
  125.                     FlushIndex(IdxF);
  126.                   end;
  127.                 log(9, '');
  128.                 list('I');
  129.                 pause
  130.               end
  131.           end
  132.     end;
  133.     
  134.     
  135.     procedure init_user;
  136.     
  137.     
  138.       procedure display_random_quote; {vdp 4/18/87. inserted procedure}
  139.       
  140.       var
  141.         sel             : Integer;
  142.       begin                       {procedure display_random_quote}
  143.         if quot_count > 0 then
  144.           begin
  145.             sel := Random(quot_count);
  146.             Seek(qidx_file, sel);
  147.             Read(qidx_file, qidx_rec);
  148.             Seek(quot_file, qidx_rec.loc);
  149.             quot_rec.Text := 'ZZZ';
  150.             WriteLn(Com);
  151.             while (not EoF(quot_file)) and (quot_rec.Text <> '') and Online do
  152.               begin
  153.                 Read(quot_file, quot_rec);
  154.                 WriteLn(Com, quot_rec.Text);
  155.               end;
  156.           end;
  157.       end;                        {procedure display_random_quote}
  158.       
  159.     begin                         {init_user}
  160.       temp_hi_lmr := user_rec.lasthi;
  161.       TempLastRead := user_rec.last_read;
  162.       if local_online then
  163.         log(2, 'Local')
  164.       else
  165.         log(2, intstr(rate, 3)+' bps');
  166.       Seek(logr_file, 0);
  167.       Read(logr_file, logr_rec);
  168.       if (logr_rec.user < 65535) and (user_rec.fn <> 'SYSOP') then
  169.         Inc(logr_rec.user)
  170.       else
  171.         if logr_rec.user >= 65535 then logr_rec.user := 1;
  172.       Seek(logr_file, 0);
  173.       Write(logr_file, logr_rec);
  174.       FlushAny(logr_file);
  175.       GetTAD(login_t);
  176.       if (login_t[3] <> user_rec.laston[3]) or (login_t[4] <> user_rec.laston[4]) or
  177.       (login_t[5] <> user_rec.laston[5]) then
  178.         user_rec.time_today := 0;
  179.       first_scan := True;
  180.       if user_rec.access < 10     { Hang up on twit }
  181.       then
  182.         remote_online := False
  183.       else
  184.         begin
  185.           if (not(user_rec.protocol in ['X', 'C', 'Y', 'B', 'Z', 'G', 'Q', 'O']))
  186.           then get_protocol;
  187.           show_user_stats;
  188.           display_random_quote;
  189.         end;
  190.     end;
  191.     
  192.     
  193.     
  194.     procedure get_name(var fn : FirstName; var ln : LastName; mode : Char);
  195.       { Get user name }
  196.       
  197.     var
  198.       try,
  199.       try_name        : Integer;
  200.       work            : StrStd;
  201.       test_names,
  202.       found, OK       : Boolean;
  203.       namesfile       : Text;
  204.       
  205.     begin
  206.       WriteLn(Com);
  207.       try := 0;
  208.       try_name := 0;
  209.       test_names := True;
  210.       found := False;
  211.       if mode = 'C' then
  212.         begin
  213.           Assign(namesfile, 'BADNAMES.LST');
  214.           {$I-}
  215.           Reset(namesfile); {$I+}
  216.           if IoResult <> 0 then
  217.             test_names := False;  {file doesn't exist}
  218.         end
  219.       else
  220.         test_names := False;
  221.       repeat
  222.         repeat
  223.           fn := trim(prompt('FIRST name', len_fn, 'ESN'));
  224.           Inc(try);
  225.         until (not Online) or (fn <> '') or (try > max_tries);
  226.         if try > max_tries then
  227.           begin
  228.             remote_online := False;
  229.             mdhangup;
  230.           end;
  231.         if fn = 'SYSOP' then
  232.           ln := ''
  233.         else
  234.           begin
  235.             try := 0;
  236.             repeat
  237.               ln := trim(prompt(' LAST name', len_ln, 'ESN'));
  238.               Inc(try);
  239.             until (not Online) or (ln <> '') or (try > max_tries);
  240.             if try > max_tries then
  241.               begin
  242.                 remote_online := False;
  243.                 mdhangup;
  244.               end;
  245.           end;
  246.         if (try < max_tries) and (mode = 'C') and (Online) and (test_names) then
  247.           begin
  248.             Reset(namesfile);
  249.             while (not EoF(namesfile)) and (Online) and (test_names) and (not found) do
  250.               begin
  251.                 ReadLn(namesfile, work);
  252.                 if (Pos(work, fn) <> 0) or (Pos(work, ln) <> 0) then
  253.                   found := True;
  254.               end;
  255.             if found then
  256.               begin
  257.                 WriteLn(Com, 'That name is reserved...try again');
  258.                 Log(19, 'Name');
  259.                 Inc(try_name);
  260.                 found := False;
  261.               end
  262.             else
  263.               test_names := False;
  264.           end;
  265.         if try_name > max_tries then
  266.           begin
  267.             remote_online := False;
  268.             mdhangup;
  269.           end;
  270.       until (not Online) or (try > max_tries) or (try_name > max_tries) or (not test_names);
  271.       if (mode = 'C') then
  272.         begin
  273.           {$I-}
  274.           Close(namesfile);
  275.           OK := (IoResult = 0);
  276.           {$I+}
  277.         end;
  278.     end;
  279.     
  280.     
  281.   begin                           { login }
  282.     abort := False;
  283.     if not cmd_tail then
  284.       begin
  285.         Delay(1000);
  286.         if Ch_Inprdy then
  287.           begin
  288.             Delay(5000);
  289.             repeat
  290.               Delay(9);
  291.               Clear_inbuf;
  292.             until not Ch_Inprdy;
  293.           end;
  294.       end;
  295.     GoToXY(1, 23);
  296.     WriteLn(Com);
  297.     WriteLn(Com, version);
  298.     WriteLn(Com, ver_date);
  299.     repeat
  300.     until (not brk) or (not Online);
  301.     if (not macro_in_progress) and (Online) then
  302.       begin
  303.         WriteLn(Com);
  304.         WriteLn(Com);
  305.         if ask(question, 'N') then
  306.           graphics_on
  307.         else
  308.           graphics_off
  309.       end;
  310.     if (not macro_in_progress) and (Online) then
  311.       list('W');
  312.     repeat
  313.       if macro_in_progress then
  314.         begin
  315.           user_rec.fn := 'SYSOP';
  316.           user_rec.ln := '';
  317.           graphics_on;
  318.         end
  319.       else
  320.         get_name(user_rec.fn, user_rec.ln, 'C');
  321.       timeout := sleepy_time;     { increase input timeout }
  322.       if user_rec.fn = 'SYSOP' then
  323.         UserFullName := fido_sysop
  324.       else UserFullName := user_rec.fn+' '+user_rec.ln;
  325.       {$V-}
  326.       caps_to_mixed(UserFullName) {$V+} ;
  327.       UserFirstName := StLocase(user_rec.fn);
  328.       UserFirstName[1] := Upcase(UserFirstName[1]);
  329.       key := pad(user_rec.ln, len_ln)+pad(user_rec.fn, len_fn);
  330.       FindKey(IdxF, user_loc, key);
  331.       if OK then
  332.         begin
  333.           GetRec(DatF, user_loc, user_rec);
  334.           if macro_in_progress then
  335.             begin
  336.               valid_pw := True;
  337.               mode := sysop_mode;
  338.             end
  339.           else
  340.             begin
  341.               get_old_password('  Password', valid_pw);
  342.               if not valid_pw then
  343.                 list('P');
  344.             end;
  345.           continue := True;
  346.         end
  347.       else
  348.         begin
  349.           if (diskfree(Ord(Upcase(HomDrv[1]))-64) div 1024) > maxfree_logs then
  350.             begin
  351.               get_new_user(continue);
  352.               if continue then
  353.                 valid_pw := True;
  354.             end
  355.           else
  356.             begin
  357.               valid_pw := False;
  358.               WriteLn(Com);
  359.               WriteLn(Com, 'Name not found. Not enough disk space for new callers.');
  360.               WriteLn(Com, '           Please call back soon.');
  361.               WriteLn(Com);
  362.               Delay(5000);
  363.               continue := False;
  364.               remote_online := False;
  365.               mdhangup;
  366.               abort := True;
  367.             end;
  368.         end;
  369.     until (not Online) or continue or abort;
  370.     in_use := valid_pw;
  371.     connected := continue;
  372.     if Online and in_use then
  373.       init_user;
  374.   end;
  375.   
  376.   
  377.   procedure wrapup;
  378.     { Disconnect, update and close all files}
  379.     
  380.     
  381.   var
  382.     i, J, time_on,
  383.     time_left       : Integer;
  384.     t               : tad_array;
  385.     
  386.   begin
  387.     SetSect(HomName);
  388.     WriteLn(Com);
  389.     Write(Com, 'Hope you enjoyed your visit, ', UserFirstName, '. Call again soon...');
  390.     WriteLn(Com);
  391.     Delay((9600 div rate)*100);
  392.     if valid_pw                   { Don't update files if user not initialized }
  393.     then
  394.       begin
  395.         GetTAD(t);
  396.         timer(time_on, time_left);
  397.         time_on := time_on-extra_time;
  398.         if (login_t[3] = t[3]) and (user_rec.access < 250) then
  399.           user_rec.time_today := user_rec.time_today+time_on
  400.         else
  401.           user_rec.time_today := 0;
  402.         user_rec.time_total := user_rec.time_total+time_on;
  403.         user_rec.laston := t;
  404.         if temp_hi_lmr > user_rec.lasthi then
  405.           user_rec.lasthi := temp_hi_lmr;
  406.         user_rec.last_read := TempLastRead;
  407.         PutRec(DatF, user_loc, user_rec);
  408.         log(3, ' ');
  409.         i := login_t[1];
  410.         J := login_t[2];
  411.         while J <> t[2] do
  412.           begin
  413.             stat_rec.busy_per_hour[J] := stat_rec.busy_per_hour[J]+60-i;
  414.             i := 0;
  415.             J := Succ(J) mod 24
  416.           end;
  417.         stat_rec.busy_per_hour[J] := stat_rec.busy_per_hour[J]+t[1]-i;
  418.         Assign(stat_file, stat_name+ext);
  419.         Reset(stat_file);
  420.         Write(stat_file, stat_rec);
  421.         Close(stat_file)
  422.       end;
  423.     CloseFile(DatF);
  424.     CloseIndex(IdxF);
  425.     CloseIndex(NewinArea);
  426.     CloseIndex(NewinName);
  427.     Close(logr_file);
  428.     Close(nwin_file);
  429.     Close(summ_file);
  430.     Close(mesg_file);
  431.     if macro_file_exists then
  432.       begin
  433.         Close(macro_file);
  434.         macro_file_exists := False;
  435.       end;
  436.     if (mode = sysop_mode) and (local_online) and (ch = 'Q') then
  437.       Halt;
  438.     mdhangup;
  439.   end;
  440.   
  441.   
  442.   
  443.   procedure check_300_restrict;
  444.   
  445.   var
  446.     t               : tad_array;
  447.     
  448.   begin
  449.     GetTAD(t);
  450.     if (rate = 300) and (restrict300) and (t[2] > start_restrict300) and
  451.     (t[2] < end_restrict300) and (not local_online) then
  452.       begin
  453.         WriteLn(Com);
  454.         WriteLn(Com, '300 Baud Callers are restricted from ', start_restrict300, ':00 - ',
  455.           end_restrict300,
  456.           ':00 hours.');
  457.         WriteLn(Com, 'Please call back outside of these times.');
  458.         Delay((9600 div rate)*200);
  459.         remote_online := False;
  460.         mdhangup;
  461.       end;
  462.   end;
  463.   
  464.   
  465. end.                              { of LOGINOUT.PAS }
  466. 
  467.